home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / grabkey.exe / GRABKEY.PAS
Encoding:
Pascal/Delphi Source File  |  1991-07-10  |  4.3 KB  |  137 lines
  1. { To Dave Tipton
  2.  
  3.    Example of an interrupt to grab the scan code of each key pressed -
  4.    but not to eat the key.  Pass the interrupt back to DOS so it can
  5.    do what it does.
  6.  
  7.    You'll need a look-Up table for the scan codes.
  8.  
  9.    OR - you could eat the key - and then put it back with
  10.    TURBO PROFESSIONAL's Stuff Key.  Play around with it.
  11.  
  12.    Compile this and run it.  'Q' Quits.  Good Luck.
  13. }
  14.  
  15.  
  16. PROGRAM GrabKeys;
  17.  
  18. { !! Keep F+ and B- for INTERRUPT and FAST Bit testing !! }
  19. {$F+,B-}
  20.  
  21. {$R-,I-,S-,L-,D-}
  22.  
  23.    { 18 June 91 }
  24.    { J. Dennis Green - 71620,2427 : Intercept and reRoute Key }
  25.  
  26. USES
  27.    TpCRT,                               { TURBO PROFESSIONAL's CRT or CRT }
  28.    DOS;                                 { For Registers, Interrupt, Error }
  29.  
  30. CONST
  31.    Key_Int    = $09;
  32.    Key_Vec    : Pointer = NIL;          { Swap Key Interrupt }
  33.    Exit_Save  : Pointer = NIL;          { Swap exit  procedure }
  34.    xKey       : Word = 0;
  35.  
  36.    RShift     =   1;                    { Constants for Bit Testing xShift }
  37.    LShift     =   2;
  38.    CtrlShift  =   4;
  39.    AltShift   =   8;
  40.    ScrollLock =  16;
  41.    NumLock    =  32;
  42.    CapsLock   =  64;
  43.    InsertLock = 128;
  44.  
  45.  
  46. VAR
  47.    ch        : Char;
  48.    xShift    : Byte Absolute $0040:$0017;  { THE information }
  49.    xExtended : Boolean;
  50.  
  51.    { Grab the keyboard interrupt, retrieve the scancode }
  52. PROCEDURE GrabKey ( Flags,CS,IP,AX,BX,CX,DX,SI,DI,DS,ES,BP : Word );
  53. INTERRUPT;
  54. BEGIN
  55.  
  56.       { Read the key directly - but don't eat it }
  57.    xKey:= PortW[$60];
  58.  
  59.       { Give it back }
  60.    InLine
  61.       (
  62.        $FB/                             { Interrupts On }
  63.        $A1/>Key_Vec+2/                  { Mov AX, [>Key_Vec+2] }
  64.                                         {    Old Vector Seg to AX }
  65.        $8B/$1E/>Key_Vec/                { Mov BX, [>Key_Vec]   }
  66.                                         {    Old Vector Ofs to BX }
  67.        $87/$5E/$0E/                     { XCHG BX,[BP+$0E]      }
  68.                                         {    Swap Ofs w/ Return address }
  69.        $87/$46/$10/                     { Xchg AX,[BP+$10]      }
  70.                                         {    Swap Set w/ Return address }
  71.        $89/$EC/                         { Mov SP,BP ; Undo entry code }
  72.        $5D/                             { POP BP }
  73.        $07/                             { POP ES }
  74.        $1F/                             { POP DS }
  75.        $5F/                             { POP DI }
  76.        $5E/                             { POP SI }
  77.        $5A/                             { POP DX }
  78.        $59/                             { POP CX }
  79.        $CB );                           { RETF ; In effect JMP to old vector }
  80.  END;
  81.  
  82.  
  83.  
  84.    { Restore the original Key Interrupt }
  85. PROCEDURE MyExit;
  86. BEGIN
  87.    ExitProc:= Exit_Save;                  { Restore normal Exit Procedure }
  88.    InLine     ($9C/$FA);                  { PushF, Cli }
  89.    SetIntVec  (Key_Int, Key_Vec );        { Restore original Key interrupt }
  90.    InLine     ($FB/$9D);                  { Sti, Pop Flags }
  91. END;
  92.  
  93.  
  94.    { Simple example to test for Shifted stuff }
  95. FUNCTION Shifted: Boolean;
  96. BEGIN
  97.    Shifted:= ( (xShift and RShift = RShift) or
  98.                (xShift and LShift = LShift) or
  99.                (xShift and CapsLock = CapsLock) );
  100. END;
  101.  
  102.  
  103. BEGIN
  104.    GetIntVec (Key_Int, Key_Vec);       { Get and Save Key interrupt }
  105.  
  106.    InLine ($FA);                       { Stop Interrupts }
  107.    SetIntVec (Key_Int, @GrabKey);      { ReRoute it to 'my' KeyRead }
  108.    InLine ($FB);                       { Allow Interrupts }
  109.  
  110.  
  111.    Exit_Save:= ExitProc;               { Get and Save normal Exit procedure }
  112.    ExitProc := @MyExit;                { ReRoute it to 'my' Exit }
  113.  
  114.  
  115.       { Main Program }
  116.    REPEAT
  117.       IF KeyPressed THEN
  118.       BEGIN
  119.  
  120.             { Lo(xKey) is ScanCode - See TP6 Table B.3 / TP5.5 Table C.3 }
  121.             { xShift is the keyboard Status }
  122.             { Writing CH just for checking }
  123.             { Note that Special Keys - (HOME) - hits this twice. }
  124.             { - xExtended is shown.  See ReadKey Explanation }
  125.  
  126.          Write ( Lo(xKey):5, xShift:5, ' ',Shifted,' -> ');
  127.          Ch:= ReadKey;
  128.          IF (Ch = 'Q') THEN Halt(0);
  129.          xExtended:= (Ch = #0);
  130.          Writeln ( ch, ' ', xExtended );
  131.       END;
  132.    UNTIL False;
  133.  
  134. END.
  135.  
  136.  
  137.